home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #2 / Ham Radio 2000 - Volume 2.iso / HAMV2 / MISC / HCAL-27 / BUTTFILT.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1997-01-27  |  7.7 KB  |  299 lines
  1. 10  'BUTTFILT - Butterworth HF Filters - 21 JUN 96 rev. 27 SEP 96
  2. 20  'ref: 1994 ARRL HANDBOOK for RADIO AMATEURS, pages 2-40 & 2-41
  3. 30  IF EX$=""THEN EX$="exit"
  4. 40  PROG$="buttfilt":GO$=EX$
  5. 50  COMMON EX$,PROG$
  6. 60  CLS:KEY OFF
  7. 70  COLOR 7,0,1
  8. 80  PI=3.14159
  9. 90  LF=1/LOG(10)
  10. 100  UL$=STRING$(80,205)
  11. 110  U$="#####.###"
  12. 120  X$=STRING$(80,32)
  13. 130  DIM H(9)     'amateur band centre frequencies
  14. 140  DIM V(9,9)   'factor values
  15. 150  '
  16. 160  '.....amateur HF band centre frequency
  17. 170  DATA 1.879, 3.742, 7.148, 10.125, 14.174, 18.118, 21.224, 24.940, 28.837
  18. 180  FOR Z=1 TO 9:READ H(Z):NEXT Z
  19. 190  '
  20. 200  '.....data from Table 10, page 2-40, 1994 ARRL Handbook
  21. 210  DATA 1, 2, 1
  22. 220  FOR Z=1 TO 3:READ V(3,Z):NEXT Z
  23. 230  DATA .618, 1.618, 2, 1.618, .618
  24. 240  FOR Z=1 TO 5:READ V(5,Z):NEXT Z
  25. 250  DATA .445, 1.247, 1.8019, 2, 1.8019, 1.247, .445
  26. 260  FOR Z=1 TO 7:READ V(7,Z):NEXT Z
  27. 270  DATA .3473, 1, 1.5321, 1.8794, 2, 1.8794, 1.5321, 1, .3473
  28. 280  FOR Z=1 TO 9:READ V(9,Z):NEXT Z
  29. 290  GOTO 720
  30. 300  '
  31. 310  '.....diagrams
  32. 320  COLOR 0,7
  33. 330  LOCATE ,T:PRINT "  LOW-PASS (Capacitor Input/Output)  "
  34. 340  LOCATE ,T:PRINT " VARPTRSOUNDSOUNDBSAVESOUNDSOUNDL2SOUNDSOUNDBSAVESOUNDSOUNDL4SOUNDSOUNDBSAVESOUNDSOUNDL6SOUNDSOUNDBSAVESOUNDSOUNDL8SOUNDSOUNDBSAVESOUNDSOUNDCOLOR "
  35. 350  LOCATE ,T:PRINT " R C1     C3     C5     C7     C9  R "
  36. 360  LOCATE ,T:PRINT " CLSSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUND' "
  37. 370  COLOR 7,0
  38. 380  RETURN
  39. 390  '
  40. 400  COLOR 0,7
  41. 410  LOCATE ,T:PRINT "  LOW-PASS (Inductor Input/Output)   "
  42. 420  LOCATE ,T:PRINT " VARPTRSOUNDL1SOUNDSOUNDBSAVESOUNDSOUNDL3SOUNDSOUNDBSAVESOUNDSOUNDL5SOUNDSOUNDBSAVESOUNDSOUNDL7SOUNDSOUNDBSAVESOUNDSOUNDL9SOUNDSOUNDCOLOR "
  43. 430  LOCATE ,T:PRINT " R     C2     C4     C6     C8     R "
  44. 440  LOCATE ,T:PRINT " CLSSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUND' "
  45. 450  COLOR 7,0
  46. 460  RETURN
  47. 470  '
  48. 480  COLOR 0,7
  49. 490  LOCATE ,T:PRINT " HIGH-PASS (Capacitor Input/Output)  "
  50. 500  LOCATE ,T:PRINT " VARPTRSOUNDC1SOUNDSOUNDBSAVESOUNDSOUNDC3SOUNDSOUNDBSAVESOUNDSOUNDC5SOUNDSOUNDBSAVESOUNDSOUNDC7SOUNDSOUNDBSAVESOUNDSOUNDC9SOUNDSOUNDCOLOR "
  51. 510  LOCATE ,T:PRINT " R     L2     L4     L6     L8     R "
  52. 520  LOCATE ,T:PRINT " CLSSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUND' "
  53. 530  COLOR 7,0
  54. 540  RETURN
  55. 550  '
  56. 560  COLOR 0,7
  57. 570  LOCATE ,T:PRINT "  HIGH-PASS (Inductor Input/Output)  "
  58. 580  LOCATE ,T:PRINT " VARPTRSOUNDSOUNDBSAVESOUNDSOUNDC2SOUNDSOUNDBSAVESOUNDSOUNDC4SOUNDSOUNDBSAVESOUNDSOUNDC6SOUNDSOUNDBSAVESOUNDSOUNDC8SOUNDSOUNDBSAVESOUNDSOUNDCOLOR "
  59. 590  LOCATE ,T:PRINT " R L1     L3     L5     L7     L9  R "
  60. 600  LOCATE ,T:PRINT " CLSSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUND' "
  61. 610  COLOR 7,0
  62. 620  RETURN
  63. 630  '
  64. 640  COLOR 0,7
  65. 650  LOCATE ,T:PRINT "          BAND-PASS          "
  66. 660  LOCATE ,T:PRINT " VARPTRSOUNDSOUNDSOUNDBSAVESOUNDSOUNDBSAVESOUNDSOUNDL2SOUNDSOUNDSOUNDC2SOUNDSOUNDBSAVESOUNDSOUNDBSAVESOUNDSOUNDSOUNDCOLOR "
  67. 670  LOCATE ,T:PRINT " R  L1 C1           L3 C3  R "
  68. 680  LOCATE ,T:PRINT " CLSSOUNDSOUNDSOUNDMOTORSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDMOTORSOUNDSOUNDSOUND' "
  69. 690  COLOR 7,0
  70. 700  RETURN
  71. 710  '
  72. 720  '.....start
  73. 730  CLS
  74. 740  COLOR 15,2
  75. 750  PRINT " BUTTERWORTH HF Filters";TAB(57)"by George Murphy VE3ERP ";
  76. 760  COLOR 1,0:PRINT STRING$(80,223);
  77. 770  COLOR 7,0
  78. 780  LOCATE 3:T=3:GOSUB 320
  79. 790  LOCATE 3:T=42:GOSUB 400
  80. 800  LOCATE 8:T=3:GOSUB 480
  81. 810  LOCATE 8:T=42:GOSUB 560
  82. 820  LOCATE 13:T=50:GOSUB 640
  83. 830  LOCATE 14
  84. 840  PRINT "  Press number in < > for:"
  85. 850  PRINT TAB(3)STRING$(24,196)
  86. 860  PRINT "  < 1 > Low-Pass filters"
  87. 870  PRINT "  < 2 > High-Pass filters"
  88. 880  PRINT "  < 3 > Band-Pass filters"
  89. 890  PRINT "  < 4 > Amateur band edge & centre frequencies"
  90. 900  PRINT "  < 5 > Custom value capacitors"
  91. 910  PRINT "  < 6 > Toroid inductor calculator"
  92. 920  PRINT "  < 7 > Air-core coil designer"
  93. 930  PRINT "  < 0 > EXIT"
  94. 940  T=50:LOCATE 17
  95. 950  LOCATE ,T:PRINT "KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE"
  96. 960  LOCATE ,T:PRINT "OPENThere is no need to alter  OPEN"
  97. 970  LOCATE ,T:PRINT "OPENthe design to suit standardOPEN"
  98. 980  LOCATE ,T:PRINT "OPENcomponents. Menu items 5-7 OPEN"
  99. 990  LOCATE ,T:PRINT "OPENenable you to assemble yourOPEN"
  100. 1000  LOCATE ,T:PRINT "OPENown custom components.     OPEN"
  101. 1010  LOCATE ,T:PRINT "SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD"
  102. 1020  COLOR 7,1
  103. 1030  LOCATE 25,5:PRINT " (from the 1994 ARRL HANDBOOK for the RADIO AMATEUR, ";
  104. 1040  PRINT "pages 2-40 & 2-41) ";
  105. 1050  COLOR 7,0
  106. 1060  Z$=INKEY$:IF Z$=""THEN 1060
  107. 1070  IF Z$="0"THEN CLS:CHAIN GO$
  108. 1080  IF Z$="1"THEN F$="Low":GOTO 1160
  109. 1090  IF Z$="2"THEN F$="High":GOTO 1160
  110. 1100  IF Z$="3"THEN 2450
  111. 1110  IF Z$="4"THEN CHAIN"hambands"
  112. 1120  IF Z$="5"THEN CHAIN"custcap"
  113. 1130  IF Z$="6"THEN CHAIN"toroid"
  114. 1140  IF Z$="7"THEN CHAIN"coildsgn"
  115. 1150  GOTO 1060
  116. 1160  VIEW PRINT 3 TO 24:CLS:VIEW PRINT
  117. 1170  IF F$="Low" THEN LOCATE 3:T=3:GOSUB 320:LOCATE 3:T=42:GOSUB 400:GOTO 1190
  118. 1180  IF F$="High"THEN LOCATE 3:T=3:GOSUB 480:LOCATE 3:T=42:GOSUB 560:GOTO 1190
  119. 1190  PRINT UL$;
  120. 1200  INPUT " ENTER: Cutoff Frequency........................(MHz)";FC
  121. 1210  IF FC=0 THEN 1160
  122. 1220  LOCATE CSRLIN-1:PRINT STRING$(80,32);:LOCATE CSRLIN-1
  123. 1230  '
  124. 1240  PRINT " Insertion Loss in dB at various frequencies where N = no. of ";
  125. 1250  PRINT "filter elements:"
  126. 1260  PRINT TAB(4)"MHz";
  127. 1270  PRINT TAB(16)"N=3";TAB(27)"N=5";TAB(38)"N=7";TAB(49)"N=9";
  128. 1280  PRINT TAB(58)"Signal"
  129. 1290  PRINT UL$;
  130. 1300  '
  131. 1310    FOR J=1 TO 9
  132. 1320  IF FC>=H(J-1)AND FC<H(J)THEN GOSUB 1460
  133. 1330  F=H(J)
  134. 1340  PRINT USING "###.###";F;
  135. 1350  IF F$="Low" THEN FQ=F/FC
  136. 1360  IF F$="High"THEN FQ=FC/F
  137. 1370  IF FQ<1 THEN S$="passed "
  138. 1380  IF FQ>1 THEN S$="blocked "
  139. 1390  GOSUB 1530
  140. 1400  IF FS THEN FS=0:RETURN
  141. 1410    NEXT J
  142. 1420  IF FC>=H(9)THEN GOSUB 1460
  143. 1430  PRINT
  144. 1440  GOTO 1600
  145. 1450  '
  146. 1460  COLOR 0,7
  147. 1470  PRINT USING "###.###";FC;
  148. 1480  FQ=1:GOSUB 1530
  149. 1490  LOCATE CSRLIN-1,58:PRINT "cutoff frequency "
  150. 1500  COLOR 7,0
  151. 1510  RETURN
  152. 1520  '
  153. 1530  T=0:FOR K=3 TO 9 STEP 2:T=T+11
  154. 1540       A=10*LOG(1+FQ^(2*K))*LF
  155. 1550  IF A<0.000999999 THEN M$="#####    "ELSE M$=U$
  156. 1560       PRINT TAB(T);USING M$;A;
  157. 1570      NEXT K:PRINT SPC(5);S$
  158. 1580  RETURN
  159. 1590  '
  160. 1600  COLOR 15,1:LOCATE ,8
  161. 1610  PRINT " Do you want to see insertion losses at another frequency?   (y/n)"
  162. 1620  COLOR 7,0
  163. 1630  Z$=INKEY$:IF Z$=""THEN 1630
  164. 1640  IF Z$="n"THEN 1740
  165. 1650  IF Z$="y"THEN 1670
  166. 1660  GOTO 1630
  167. 1670  LOCATE CSRLIN-1:PRINT X$;:LOCATE CSRLIN-1
  168. 1680  COLOR 15,2
  169. 1690  INPUT " ENTER: Specific frequency (MHz).....................";FS
  170. 1700  COLOR 7,0
  171. 1710  LOCATE CSRLIN-1:PRINT X$;:LOCATE CSRLIN-2
  172. 1720  F=FS:COLOR 0,7:GOSUB 1340:COLOR 7,0:GOTO 1600
  173. 1730  '
  174. 1740  LOCATE CSRLIN-1:PRINT X$;:LOCATE CSRLIN-1
  175. 1750  COLOR 14,4
  176. 1760  INPUT " ENTER: Number of circuit elements (your choice).....";N
  177. 1770  COLOR 7,0
  178. 1780  IF N>=3 AND N<=9 AND N/2<>INT(N/2)THEN 1790 ELSE 1740
  179. 1790  VIEW PRINT 9 TO 24:CLS:VIEW PRINT:LOCATE 9
  180. 1800  '
  181. 1810  COLOR 0,7
  182. 1820  IF N=3 THEN T1=16:T2=21:T3=55
  183. 1830  IF N=5 THEN T1=23:T2=14:T3=62
  184. 1840  IF N=7 THEN T1=30:T2=7 :T3=69
  185. 1850  IF N=9 THEN T1=37:T2=0 :T3=76
  186. 1860  T$(3)="  ":T$(4)="SOUNDCOLOR":T$(5)=" R":T$(6)="SOUND'"
  187. 1870  FOR Z=4 TO 6
  188. 1880  LOCATE Z,T1:PRINT T$(Z);STRING$(T2,32)
  189. 1890  LOCATE Z,T3:PRINT T$(Z);STRING$(T2,32)
  190. 1900  NEXT Z
  191. 1910  COLOR 7,0
  192. 1920  VIEW PRINT 8 TO 24:CLS:VIEW PRINT:LOCATE 8
  193. 1930  '
  194. 1940  INPUT " ENTER: I/O Resistance R (ohms)......................";R
  195. 1950  VIEW PRINT 7 TO 24:CLS:VIEW PRINT:LOCATE 7
  196. 1960  '
  197. 1970  PRINT TAB(4)N;"ELEMENT FILTER";TAB(43)N;"ELEMENT FILTER"
  198. 1980  PRINT
  199. 1990  PRINT TAB(5)"I/O Resistance R =";USING U$;R;:PRINT " -";
  200. 2000  PRINT TAB(44)"I/O Resistance R =";USING U$;R;:PRINT " -"
  201. 2010  PRINT TAB(5)"Cutoff frequency =";USING U$;FC;:PRINT " MHz";
  202. 2020  PRINT TAB(44)"Cutoff frequency =";USING U$;FC;:PRINT " MHz"
  203. 2030  PRINT
  204. 2040  '
  205. 2050  '.....calculation
  206. 2060  FOR Z=1 TO N
  207. 2070  Z$=RIGHT$(STR$(Z),1)
  208. 2080  IF Z/2=INT(Z/2)THEN A$="L":B$="C"ELSE A$="C":B$="L"
  209. 2090  IF A$="L"THEN GOSUB 2330 ELSE GOSUB 2360
  210. 2100  LOCATE ,19:PRINT A$+Z$+" =";USING U$;X;:PRINT Y$;
  211. 2110  IF B$="L"THEN GOSUB 2330 ELSE GOSUB 2360
  212. 2120  LOCATE ,58:PRINT B$+Z$+" =";USING U$;X;:PRINT Y$
  213. 2130  NEXT Z
  214. 2140  LN=CSRLIN
  215. 2150  LOCATE 3,2:PRINT "VARPTR"
  216. 2160  LOCATE 3,40:PRINT "COLORVARPTR"
  217. 2170  LOCATE 3,79:PRINT "COLOR"
  218. 2180  FOR Z=4 TO LN
  219. 2190  LOCATE Z,2:PRINT "CALL"
  220. 2200  LOCATE Z,40:PRINT "CALLCALL"
  221. 2210  LOCATE Z,79:PRINT "CALL"
  222. 2220  NEXT Z
  223. 2230  LOCATE LN
  224. 2240  PRINT STRING$(80,196);
  225. 2250  LOCATE CSRLIN-1,1:PRINT " CLS"
  226. 2260  LOCATE CSRLIN-1,40:PRINT "'CLS"
  227. 2270  LOCATE CSRLIN-1,79:PRINT "' ";
  228. 2280  PRINT TAB(9);
  229. 2290  PRINT "The use of silver-mica or polystyrene capacitors is recommended."
  230. 2300  PRINT TAB(13)"Inductors should be wound on powdered-iron toroid cores."
  231. 2310  GOTO 2820
  232. 2320  '
  233. 2330  IF F$="Low" THEN X=R/(2*PI*FC)*V(N,Z)
  234. 2340  IF F$="High"THEN X=R/(2*PI*FC*V(N,Z))
  235. 2350  Y$=" >H":RETURN
  236. 2360  IF F$="Low" THEN X=1/(2*PI*FC*R)*V(N,Z)*10^6
  237. 2370  IF F$="High"THEN X=1/(2*PI*FC*R*V(N,Z))*10^6
  238. 2380  Y$=" pF":RETURN
  239. 2390  '
  240. 2400  '.....format input line
  241. 2410  LOCATE CSRLIN-1:PRINT SPC(7);
  242. 2420  LOCATE CSRLIN,47:PRINT STRING$(7,".");USING U$;ZZ;
  243. 2430  RETURN
  244. 2440  '
  245. 2450  '.....bandpass
  246. 2460  VIEW PRINT 3 TO 24:CLS:VIEW PRINT:LOCATE 3
  247. 2470  T=26:GOSUB 640
  248. 2480  PRINT UL$;
  249. 2490  INPUT " ENTER: I/O resistance R.......................(ohms)";R
  250. 2500  ZZ=R:GOSUB 2400:PRINT " ohms"
  251. 2510  INPUT " ENTER: Upper limit of pass-band................(MHz)";FU
  252. 2520  ZZ=FU:GOSUB 2400:PRINT " MHz"
  253. 2530  PRINT
  254. 2540  INPUT " ENTER: Lower limit of pass-band................(MHz)";FL
  255. 2550  ZZ=FL:GOSUB 2400:PRINT " MHz"
  256. 2560  FO=SQR(FU*FL)
  257. 2570  LOCATE CSRLIN-2
  258. 2580  PRINT "        Centre frequency of pass-band................";
  259. 2590  PRINT USING U$;FO;:PRINT " MHz"
  260. 2600  BW=ABS(FU-FL)
  261. 2610  LOCATE CSRLIN+1
  262. 2620  PRINT "        Bandwidth of pass-band.......................";
  263. 2630  PRINT USING U$;BW;:PRINT " MHz"
  264. 2640  C(1)=1/(2*PI*BW*R)*V(3,1)*10^6
  265. 2650  L(1)=25330.3/FO^2/C(1)
  266. 2660  L(2)=R/(2*PI*BW)*V(3,2)
  267. 2670  C(2)=25330.3/FO^2/L(2)
  268. 2680  C(3)=1/(2*PI*BW*R)*V(3,3)*10^6
  269. 2690  L(3)=25330.3/FO^2/C(3)
  270. 2700  FOR Z=1 TO 3
  271. 2710   Z$=RIGHT$(STR$(Z),1)
  272. 2720   PRINT
  273. 2730   PRINT TAB(49)"L";Z$;"...";USING U$;L(Z);:PRINT " >H"
  274. 2740   PRINT TAB(49)"C";Z$;"...";USING U$;C(Z);:PRINT " pF"
  275. 2750  NEXT Z
  276. 2760  LOCATE 23
  277. 2770  PRINT TAB(9);
  278. 2780  PRINT "The use of silver-mica or polystyrene capacitors is recommended."
  279. 2790  PRINT TAB(13)"Inductors should be wound on powdered-iron toroid cores.";
  280. 2800  GOTO 2820
  281. 2810  '
  282. 2820  '.....end
  283. 2830  GOSUB 2860
  284. 2840  GOTO 720
  285. 2850  '
  286. 2860  'HARDCOPY
  287. 2870  GOSUB 2980:LOCATE 25,2:COLOR 14,6
  288. 2880  PRINT " Press 1 to print screen, 2 to print screen & ";
  289. 2890  PRINT "advance paper, or 3 to continue.";:COLOR 7,0
  290. 2900  Z$=INKEY$:IF Z$="3"THEN GOSUB 2980:RETURN
  291. 2910  IF Z$="1"OR Z$="2"THEN GOSUB 2980:GOTO 2930
  292. 2920  GOTO 2900
  293. 2930  FOR QX=1 TO 24:FOR QY=1 TO 80
  294. 2940  LPRINT CHR$(SCREEN(QX,QY));
  295. 2950  NEXT QY:NEXT QX
  296. 2960  IF Z$="2"THEN LPRINT CHR$(12)
  297. 2970  GOTO 2870
  298. 2980  LOCATE 25,1:PRINT STRING$(80,32);:RETURN
  299.